home *** CD-ROM | disk | FTP | other *** search
- { Created: 1997-02-14 by Berend (c) 1997 by ASC
-
- Sample Extended stored procedures.
-
- $Revision: $
-
-
- $History$
-
- }
-
-
- library xpdelphi;
-
- uses
- Windows,
- SysUtils,
- Classes,
- Odsxp;
-
-
- type
- { simple examples }
- TXPIncByOne1 = class(TSQLXProc)
- function Execute: Boolean; override;
- end;
-
- TXPIncByOne2 = class(TSQLXProc)
- function Execute: Boolean; override;
- end;
-
- { examples from xp.c }
- TXPEcho = class(TSQLXProc)
- function Execute: Boolean; override;
- end;
-
- TXPDiskList = class(TSQLXProc)
- function Execute: Boolean; override;
- end;
-
-
-
- { TXPIncByOne1 }
-
- function TXPIncByOne1.Execute: Boolean;
- begin
- Params[1] := Params[1] + 1;
- Result := True;
- end;
-
-
- { TXPIncByOne2 }
-
- function TXPIncByOne2.Execute: Boolean;
- var
- myint: integer;
- begin
- DescribeColumn('my column name', SRVINT4, 4, SRVINT4, 4, @myint);
- Myint := Params[1] + 1;
- SendRow;
- Result := True;
- end;
-
-
- { TXPEcho }
-
- function TXPEcho.Execute: Boolean;
- begin
- Params[2] := Params[1];
- Result := True;
- end;
-
-
- { TXPDiskList }
-
- function TXPDiskList.Execute: Boolean;
- var
- drivename: char;
- space_remaining: Int32;
- drivenums: Int32;
- rootname: string;
- SectorsPerCluster,
- BytesPerSector,
- NumberOfFreeClusters,
- TotalNumberOfClusters: dword;
-
- function IsDrive(drive: char): Boolean;
- begin
- IsDrive := (drivenums and (1 shl (Ord(drive) - Ord('A')))) <> 0;
- end;
-
- begin
- DescribeColumn('drive', SRVCHAR, 1, SRVCHAR, 1, @drivename);
- DescribeColumn('bytes free', SRVINT4, 4, SRVINT4, 4, @space_remaining);
- drivenums := GetLogicalDrives;
- for drivename := 'C' to 'Z' do begin
- if IsDrive(drivename) then begin
- rootname := drivename + ':\';
- GetDiskFreeSpace(PChar(rootname), SectorsPerCluster, BytesPerSector, NumberOfFreeClusters, TotalNumberOfClusters);
- space_remaining := SectorsPerCluster * NumberOfFreeClusters * BytesPerSector;
- SendRow;
- end;
- end;
- Result := True;
- end;
-
-
-
- { xp_incbyone1 }
-
- function xp_incbyone1(srvproc: PSRV_PROC): SRVRETCODE;
- const
- ExpectedParams = 1;
- var
- xp: TSQLXProc;
- begin
- xp := TXPIncByOne1.Create(srvproc, ExpectedParams);
- Result := xp.Run;
- xp.Free;
- end;
-
-
- { xp_incbyone2 }
-
- function xp_incbyone2(srvproc: PSRV_PROC): SRVRETCODE;
- const
- ExpectedParams = 1;
- var
- xp: TSQLXProc;
- begin
- xp := TXPIncByOne2.Create(srvproc, ExpectedParams);
- Result := xp.Run;
- xp.Free;
- end;
-
-
- { xp_echo }
-
- function xp_delphiecho(srvproc: PSRV_PROC): SRVRETCODE;
- const
- ExpectedParams = 2;
- var
- xp: TSQLXProc;
- begin
- xp := TXPEcho.Create(srvproc, ExpectedParams);
- Result := xp.Run;
- xp.Free;
- end;
-
-
- { xp_disklist }
-
- function xp_delphidisklist(srvproc: PSRV_PROC): SRVRETCODE;
- const
- ExpectedParams = 0;
- var
- xp: TSQLXProc;
- begin
- xp := TXPDiskList.Create(srvproc, ExpectedParams);
- Result := xp.Run;
- xp.Free;
- end;
-
-
-
- exports
- xp_incbyone1 index 1,
- xp_incbyone2 index 2,
- xp_delphiecho index 3,
- xp_delphidisklist index 4;
-
-
- begin
- end.
-